home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 October / EnigmA AMIGA RUN 01 (1995)(G.R. Edizioni)(IT)[!][issue 1995-10][Aminet 7].iso / Aminet / comm / xeno / bbbbscd.lha / BBBBScd / System / s / bbsExtDL.baud < prev    next >
Text File  |  1995-03-18  |  22KB  |  823 lines

  1. /* $VERS: bbsExtDL.baud 8.2 (17.10.94) copyright 1992-94 Richard Stockton
  2.                          FREELY DISTRIBUTABLE
  3.  
  4. ****************************************************************************
  5. CONVERTED FOR XENOLINK PRO BBS. $VERS:1.0 (18.03.95) by Derek Scott,2:259/75
  6. ****************************************************************************
  7.  
  8. Allows Xenolink user to download from extra devices like CD drives.
  9. Keeps track of time left to this user.
  10.  
  11. Just ignores file or directory names that contain spaces because Xenolink
  12. would be unable to download them anyway. (But handles recursive files &
  13. directories OK, archived by LZX by use of 'SELECT ALL' parameter)
  14.  
  15. Ignores icons (files that end in .info).
  16.  
  17. A textfile  CD_Exclude , controls exclusion of drawers on certain CDs that
  18. contain copyright files. Other specific files or directories can be excluded
  19. by adding their paths to the CD_Exclude textfile, one path per line.
  20.  
  21. Super-sysop may select very large directories and have their formatted 
  22. display lists cached as textfiles in bbspath'Cache'. This can greatly 
  23. improve access time for very large drawers, especially if they contain
  24. sub-directories.
  25.  
  26. Ability to 'READ' text files from within CD door.
  27.  
  28. Configurable 'maximum size' of user selected files/output archive.
  29.  
  30. All Selected files are Archived with LZX and attached to private mail for
  31. user. (requires "Junkmail" Xenolink utility by Alan Bland)
  32. */
  33.  
  34.  
  35.  OPTIONS RESULTS  /*sets internal default to request RESULTS string from host*/
  36.  FF='0C'x         /* defines hex-decimal value for FORM FEED (clear screen)*/
  37.  CR='0D'x         /* defines hex-decimal value for CARRIAGE RETURN*/
  38.  
  39. SIGNAL ON BREAK_C
  40. SIGNAL ON BREAK_E
  41. SIGNAL ON ERROR
  42.  
  43. PARSE ARG name
  44.  
  45.  
  46. cfgfile='xconfig:BBBBScd.config'
  47.  
  48.  
  49.  
  50.  /* Open the support library if it is not already open.  (yawn...)*/
  51.  
  52.  if ~show('L',"rexxsupport.library") THEN
  53.    DO
  54.     addlib('rexxsupport.library',0,-30,0)
  55.    END
  56.  
  57.  if ~show('L',"rexxmathlib.library") THEN
  58.    DO
  59.     addlib('rexxmathlib.library',0,-30,0)
  60.    END
  61. PRINT ' '
  62.  
  63.  if ~show('L',"rexxarplib.library") THEN
  64.    DO
  65.     addlib('rexxarplib.library',0,-30,0)
  66.    END
  67.  
  68. IF ~SHOW('P','QuickSortPort') THEN 
  69. DO
  70.   /*  Add the QuickSort port, so we can use QSORT.
  71.    *   First check if the port is already up. If not, run QuickSort
  72.    *   and wait for the port to be there  */
  73.   if ~showlist('p','QuickSortPort') then
  74.   do
  75.     ADDRESS COMMAND "run quicksort >NIL:"
  76.     do i = 1 to 10
  77.       if ~showlist('p','QuickSortPort') then call delay 20
  78.       else leave i
  79.     end
  80.     if showlist('p','QuickSortPort') then call addlib('QuickSortPort',-30)   
  81.   end
  82. end
  83. IF ~SHOW('P','QuickSortPort') THEN EXIT 666
  84.  
  85.  
  86. /* read the configuration parameters from XCONFIG:BBBBScd.CFG */
  87. x=OPEN(f,cfgfile,'R')
  88. IF x~=0 THEN 
  89.   DO
  90.     bbspath=READLN(f)
  91.     devlist=READLN(f)
  92.     sysoplevel=VALUE(WORD(READLN(f),1))
  93.     junk=READLN(f)
  94.     junk=READLN(f)
  95.     xrecursive_size=VALUE(WORD(READLN(f),1))
  96.     junk=READLN(f)
  97.     lzxflag=READLN(f)
  98.     CALL CLOSE(f)
  99.   END
  100. ELSE
  101.   /* can't open config file, so use defaults... :) */
  102.   DO
  103.     bbspath='doors:bbbbsCD/'
  104.     devlist='CD0: CD1: CD2: CD50: CD51: CD52: CD53: CD54: CD55: CD56:'
  105.     sysoplevel=224 
  106.     lzxflag='N'
  107.   END
  108. /***************************************************************************/
  109.  
  110.  
  111. /* read additional parameters about user, passed by Xenolink node */
  112. x=OPEN(f,'ram:CDuserinfo','R')
  113. IF x~=0 THEN 
  114. DO
  115.   ulevel=READLN(f)
  116.   maxtimex=READLN(f)
  117.   linesperpagex=READLN(f)
  118.   menuset=READLN(f)
  119.   nodex=READLN(f)
  120.   namex=READLN(f)
  121.   CALL CLOSE(f)
  122. END
  123. ELSE EXIT
  124.  
  125.  
  126. IF name~=namex THEN 
  127. DO
  128.   PRINT '*ERROR* Username does not match, please retry!'
  129.   EXIT
  130. END
  131.  
  132. level=VALUE(ulevel)
  133. maxtime=VALUE(maxtimex)*60
  134. IF maxtime > 3600 THEN maxtime=3600
  135. linesperpage=VALUE(linesperpagex)
  136. colorflag=VALUE(menuset)
  137. node=VALUE(nodex)
  138.  
  139. exclude=''
  140. x=OPEN(f,bbspath'CD_Exclude','R')
  141. IF x~=0 THEN exclude=READCH(f,65000)
  142. CALL CLOSE(f)
  143. exclude=UPPER(TRANSLATE(exclude,' ','0A'x))
  144.  
  145. lists.=''
  146. lists.0=0
  147. maxtime=maxtime-30
  148. CALL TIME('R')
  149. CR='0D'x
  150. def=''
  151. pen3=''
  152. IF colorflag<1 THEN
  153.   DO
  154.     def=''
  155.     pen3=''
  156.   END
  157. ELSE colorflag=1
  158.  
  159.  
  160. saytxt=FF
  161. PRINT saytxt
  162.  
  163. x=OPEN(f,bbspath'EXT_INFO','R')
  164. IF x=0 THEN PRINT bbspath'EXT_INFO failed to open!'
  165. ELSE
  166.   DO
  167.     DO i=1 WHILE ~EOF(f)
  168.       saytxt=READLN(f)||CR
  169.       PRINT saytxt
  170.       IF (i+2)//linesperpage=0 THEN
  171.         DO
  172.           PROMPT 2 NORMAL 'Press RETURN'
  173.           junk=Result
  174.           saytxt='1B'x'M'||'1B'x'M'CR
  175.           PRINT saytxt
  176.         END
  177.     END
  178.     CALL CLOSE(f)
  179.   END
  180. selected=''
  181. path=''
  182. templist=devlist
  183. devlist=''
  184. longest=0
  185. CALL PRAGMA('W','N')  /* disk requesters OFF */
  186. CALL PRAGMA('D',bbspath'Information')
  187. test3=PRAGMA('D')
  188. DO i=1 TO WORDS(templist)
  189.   test=WORD(templist,i)
  190.   IF ~EXISTS(test) THEN ITERATE i
  191.   IF SHOWLIST('A',UPPER(LEFT(test,LENGTH(test)-1))) THEN test2=test
  192.   ELSE
  193.     DO
  194.       CALL PRAGMA('D',test)
  195.       test2=PRAGMA('D')
  196. /************************************************************/
  197. /* DAS - Fool System into thinking Assigns are REAL Devices */
  198.       IF test2='d::' THEN test2='Pro_CD1:'
  199. /* DAS */
  200. /************************************************************/
  201.       IF test2=test3 THEN ITERATE i
  202.       IF WORDS(test2)>1 THEN test2=test
  203.     END
  204.   devlist=STRIP(devlist test2)
  205.   IF LENGTH(test2)>longest THEN longest=LENGTH(test2)
  206. END
  207. cols=76%(longest+8)
  208. IF devlist='' THEN
  209.   DO
  210.     PRINT
  211.     saytxt='*** Sorry, no External Devices are available! ***'CR
  212.     PRINT saytxt
  213.     PRINT
  214.     PROMPT 2 NORMAL 'Press RETURN'
  215.     junk=Result
  216.     EXIT('')
  217.   END
  218.  
  219. picklist=devlist
  220. IF WORDS(picklist)=1 THEN
  221.   DO
  222.     path=picklist
  223.     IF RIGHT(path,1)~=':' THEN path=path'/'
  224.     picklist=makepicklist()
  225.   END
  226. ELSE
  227.   DO
  228.     lists.0=1
  229.     dirs=WORDS(devlist)
  230.   END
  231.  
  232. PROMPT 2 NORMAL 'Press RETURN'
  233. junk=Result
  234.  
  235. DO loop=1
  236.   test=TIME('E')
  237.   IF test>(maxtime-100) THEN
  238.     DO
  239.       PRINT
  240.       IF test>maxtime THEN
  241.         DO
  242.           saytxt='*** This session''s time is expiring! ***'CR
  243.           PRINT saytxt
  244.           PRINT
  245.           LEAVE loop
  246.         END
  247.       ELSE PRINT '*** Less than 2 minutes remaining! ***'
  248.       PRINT CR
  249.     END
  250.   filename=pick(picklist)
  251.   IF filename='' THEN
  252.     DO
  253.       temp=path
  254.       IF RIGHT(temp,1)='/' THEN temp=LEFT(temp,LENGTH(temp)-1)
  255.       IF FIND(UPPER(devlist),UPPER(temp))>0 THEN
  256.         DO
  257.           IF WORDS(devlist)=1 THEN ITERATE loop
  258.           picklist=devlist
  259.           path=''
  260.           ITERATE loop
  261.         END
  262.       ELSE
  263.         DO
  264.           test=RIGHT(path,1)
  265.           IF test='/' THEN path=LEFT(path,LENGTH(path)-1)
  266.           slash=LASTPOS('/',path)
  267.           IF slash=0 THEN slash=LASTPOS(':',path)
  268.           path=LEFT(path,slash)
  269.         END
  270.     END
  271.   IF filename=':-)' THEN ITERATE loop
  272.   tempath=path||filename
  273.   temp=WORD(STATEF(tempath),1)
  274.   IF temp='FILE' THEN
  275.     DO
  276.       IF FIND(UPPER(selected),UPPER(tempath))=0 THEN
  277.         selected=selected tempath
  278.       ELSE selected=DELWORD(selected,FIND(UPPER(selected),UPPER(tempath)),1)
  279.       shosel=''
  280.       ITERATE loop
  281.     END
  282.   ELSE IF temp='DIR' THEN
  283.     DO
  284.       path=tempath
  285.       test=RIGHT(path,1)
  286.       IF test~='' & test~='/' & test~=':' THEN path=path'/'
  287.     END
  288.   ELSE IF UPPER(filename)='DONE' THEN LEAVE loop
  289.   IF path~='' THEN picklist=makepicklist()
  290. END
  291. selected=STRIP(selected)
  292. test=''
  293. /* IF WORDS(selected)>0 THEN test=UPPER(RIGHT(selected,4))
  294. IF selected~='' & test~='.LZX' & test~='.LHA' & test~='.LZH' & test~='.DMS' & test~='.ZOO' THEN */
  295. IF WORDS(selected)>0 THEN
  296.   DO
  297.     PRINT
  298.     PRINT 'You may choose to have your selection(s) archived using LhA or LZX.'
  299.     PRINT 'Answer [Y] to begin, or [N] to CANCEL ALL your selected files.'
  300.     PRINT 'The completed archive will be attached to email addressed to you.'
  301.     PRINT
  302.     PROMPT 2 NORMAL 'Archive selected files? (nY) > '
  303.     temp=Result
  304.     temp=UPPER(temp)
  305.     IF LEFT(temp,1)~='N' THEN
  306.       DO
  307.         DO jj = 1
  308.           PRINT ' '
  309.           IF lzxflag='Y' THEN
  310.             DO
  311.               PROMPT 2 NORMAL 'Archive using lz(X) or l(H)a? (xH) > '
  312.               temp=Result
  313.               IF temp='' THEN iterate jj
  314.               temp=LEFT(UPPER(temp),1)
  315.               IF temp~='X' & temp~='H' THEN iterate jj
  316.             END
  317.           ELSE
  318.               temp='H' /* temporarily - default to LHA */
  319.           ADDRESS AREXX bbsArcExt.rexx name nodex temp selected
  320.         LEAVE jj
  321.         END
  322.         selected=''
  323.         PRINT
  324.         PRINT 'The BBS will notify you online when your archive is ready.'
  325.         PRINT
  326.       END
  327.  
  328.   END
  329. PRINT 'Returning to the BBS...'
  330. PRINT ' '
  331. EXIT
  332.  
  333.  
  334. makepicklist:
  335. IF path='' THEN RETURN ''
  336. IF STORAGE()<100000 THEN
  337.   DO
  338.     lists.=''
  339.     lists.0=0
  340.     IF WORDS(devlist)>1 THEN
  341.       DO
  342.         lists.0=1
  343.         lists.1.0=devlist
  344.       END
  345.   END
  346. DO i=1 TO lists.0
  347.   IF path=lists.i THEN RETURN lists.i.0
  348. END
  349. cname=STRIP(RIGHT(COMPRESS(path,' ._-:/'),29))
  350. IF cname~='' & EXISTS(bbspath'Cache/'cname) THEN
  351.   DO cloop=1 TO 1
  352.     k=lists.0+1
  353.     lists.0=k
  354.     x=OPEN(f,bbspath'Cache/'cname'.','R')
  355.     IF x=0 THEN PRINT bbspath'Cache/'cname'. failed to open!'
  356.     ELSE
  357.       DO
  358.         cpath=READLN(f)
  359.         IF cpath=path THEN lists.k=path
  360.         ELSE
  361.           DO
  362.             IF level>sysoplevel THEN
  363.               PRINT path 'does not match cache path in' cname'. !'
  364.             CALL CLOSE(f)
  365.             lists.0=lists.0-1
  366.             LEAVE cloop
  367.           END
  368.         DO i=1
  369.           line=READLN(f)
  370.           IF EOF(f) THEN LEAVE i
  371.           IF colorflag~=1 THEN
  372.             DO
  373.               n=POS('1B'x,line)
  374.               DO WHILE n>0
  375.                 DO m=2
  376.                   IF DATATYPE(SUBSTR(line,n+m,1),'M') | (n+m+1)>LENGTH(line) THEN
  377.                     leave m
  378.                 END
  379.                 line=DELSTR(line,n,m+1)
  380.                 n=POS('1B'x,line)
  381.               END
  382.             END
  383.           lists.k.i=line
  384.         END
  385.         CALL CLOSE(f)
  386.         lists.k.ROWS=i-1
  387.       END
  388.     x=OPEN(f,bbspath'Cache/'cname,'R')
  389.     IF x=0 THEN
  390.       DO
  391.         PRINT bbspath'Cache/cname failed to open!'CR
  392.         CALL CLOSE(f)
  393.         lists.0=lists.0-1
  394.         LEAVE cloop
  395.       END
  396.     ELSE
  397.       DO
  398.         plist=READCH(f,65000)
  399.         CALL CLOSE(f)
  400.         lists.k.0=plist
  401.         RETURN plist
  402.       END
  403.   END
  404. PRINT 'Loading...'CR
  405. CALL FileList(path'*',filelist,'F','N')
  406. IF filelist.0>1 THEN CALL QSORT(1,filelist.0,filelist)
  407. CALL FileList(path'*',dirlist,'D','N')
  408. IF dirlist.0>1 THEN CALL QSORT(1,dirlist.0,dirlist)
  409. plist=''
  410. dirs=0
  411. longest=0
  412. DO i=1 TO filelist.0
  413.   IF WORDS(filelist.i)~=1 THEN ITERATE i
  414.   IF filelist.i='' THEN ITERATE i
  415.   IF UPPER(RIGHT(filelist.i,5))='.INFO' THEN ITERATE i
  416.   IF FIND(exclude,UPPER(path||filelist.i))>0 THEN ITERATE i
  417.   plist=STRIP(plist filelist.i)
  418.   IF LENGTH(filelist.i)>longest THEN longest=LENGTH(filelist.i)
  419. END
  420. DO i=1 TO dirlist.0
  421.   IF WORDS(dirlist.i)~=1 THEN ITERATE i
  422.   IF FIND(exclude,UPPER(path||dirlist.i))>0 THEN ITERATE i
  423.   plist=STRIP(plist dirlist.i)
  424.   IF LENGTH(dirlist.i)>longest THEN longest=LENGTH(dirlist.i)
  425.   dirs=dirs+1
  426. END
  427. cols=76%(longest+9)
  428. lists.0=lists.0+1
  429. i=lists.0
  430. lists.i=path
  431. lists.i.0=plist
  432. DROP filelist. dirlist. 
  433. RETURN plist
  434.  
  435.  
  436. pick:
  437. PARSE ARG list 
  438. selection=''
  439. DO k=1 TO lists.0
  440.   IF path=lists.k THEN LEAVE k
  441. END
  442. IF ~DATATYPE(lists.k.ROWS,'N') THEN
  443.   DO
  444.     items=WORDS(list)
  445.     IF items<75 & dirs<25 THEN PRINT 'Formatting' items 'items...'
  446.     ELSE PRINT 'Please be patient, formatting' items 'items may take a while the first time...'
  447.     lists.k.ROWS=(items%cols)+((items//cols)>0)
  448.     IF cols>items THEN cols=items
  449.     IF cols<1 THEN cols=1
  450.     longest=(76%cols)-8
  451.     lists.k=path
  452.     DO j=0 TO cols-1
  453.       DO i=1 TO lists.k.ROWS
  454.         thisnum=j*lists.k.ROWS+i
  455.         IF thisnum<=items THEN
  456.           DO
  457.             thisitem=WORD(list,thisnum)
  458.             filestat=STATEF(path||thisitem)
  459.             thisitem=LEFT(thisitem,longest)' '
  460.             IF WORD(filestat,1)='DIR' THEN
  461.               lists.k.i=lists.k.i||pen3'(dir) 'thisitem||def
  462.             ELSE
  463.               DO
  464.                 bytes=WORD(filestat,2)
  465.                 IF bytes<10000 THEN 
  466.                   lists.k.i=lists.k.i||RIGHT(bytes,5) thisitem
  467.                 ELSE IF bytes>1023999 THEN 
  468.                   lists.k.i=lists.k.i||RIGHT(bytes%1024000,4)'m' thisitem
  469.                 ELSE lists.k.i=lists.k.i||RIGHT(bytes%1024,4)'k' thisitem
  470.               END
  471.           END
  472.       END
  473.     END
  474.     IF level>sysoplevel & items>24 THEN
  475.       DO
  476.         PRINT items 'items,' dirs 'dirs,' lists.k.ROWS 'rows'
  477.         PROMPT 2 NORMAL 'FileCache' path'? (Ny) > '
  478.         junk=Result
  479.         junk=UPPER(LEFT(junk,1))
  480.         IF junk='Y' THEN
  481.           DO
  482.             CALL MAKEDIR(bbspath'Cache')
  483.             cname=STRIP(RIGHT(COMPRESS(path,' ._-:/'),29))
  484.             x=OPEN(f,bbspath'Cache/'cname,'W')
  485.             IF x=0 THEN PRINT 'Unable to open cache file' cname'!'
  486.             ELSE
  487.               DO
  488.                 CALL WRITECH(f,list)
  489.                 CALL CLOSE(f)
  490.               END
  491.             x=OPEN(f,bbspath'Cache/'cname'.','W')
  492.             IF x=0 THEN
  493.               DO
  494.                 PRINT 'Unable to open cache file' cname'. !'CR
  495.                 CALL DELETE(bbspath'Cache/'cname)
  496.               END
  497.             ELSE
  498.               DO
  499.                 CALL WRITELN(f,path)
  500.                 DO i=1 TO lists.k.ROWS
  501.                   CALL WRITELN(f,TRIM(lists.k.i))
  502.                 END
  503.                 CALL CLOSE(f)
  504.                 PRINT path 'has been cached.'
  505.               END
  506.           END
  507.       END
  508.   END
  509. IF selected~='' THEN
  510.   DO
  511.     PRINT
  512.     w=WORDS(selected)
  513.     temp=pen3' 'w def'selected files.'
  514.     IF shosel~=1 THEN
  515.       DO
  516.         saytxt=pen3'selected:'def||CR
  517.         PRINT saytxt
  518.         DO i=1 TO w
  519.           saytxt=WORD(selected,i)||CR
  520.           PRINT saytxt
  521.         END
  522.       END
  523.     ELSE
  524.     DO
  525.       temp='Enter' pen3'SHOW S'def'elected to display'temp
  526.       PRINT temp||CR
  527.     END
  528.     IF w>5 THEN shosel=1
  529.   END
  530. PRINT CR
  531. saytxt='current path ='pen3 path||def||CR
  532. PRINT saytxt
  533. saytxt=LEFT('-',75,'-')||CR
  534. PRINT saytxt
  535. DO i=1 TO lists.k.ROWS
  536.   saytxt=TRIM(lists.k.i)||CR
  537.   PRINT saytxt
  538.   IF (i+2)//(linesperpage-1)=0 & nonstop~=1 THEN
  539.     DO
  540.       CALL whodat()
  541.       PROMPT 2 NORMAL  ' - ['pen3'N'def']on-stop  ['pen3'Q'def']uit  ['pen3'RETURN'def']=Continue - '
  542.       junk=Result
  543.       IF LEFT(UPPER(junk),1)='Q' THEN LEAVE i
  544.       IF LEFT(UPPER(junk),1)='N' THEN nonstop=1
  545.     END
  546. END
  547. nonstop=0
  548. saytxt=LEFT('-',75,'-')||CR
  549. PRINT saytxt
  550. CALL whodat()
  551. readflag=0
  552. DO getloop=1
  553.   pstring=showtime()'   Enter ''?'' for HELP > '
  554.   PROMPT 80 NORMAL pstring
  555.   selection=Result
  556.   /* PARSE selection */
  557.   IF selection='?' THEN
  558.     DO
  559.       CALL help()
  560.       PROMPT 2 NORMAL 'Press RETURN'
  561.       junk=Result
  562.       selection=';-)'
  563.       LEAVE getloop
  564.     END
  565.   IF LEFT(selection,1)='/' THEN selection=STRIP(SUBSTR(selection,2))
  566.   IF WORDS(selection)>1 THEN
  567.     DO
  568.       IF LEFT(UPPER(selection),6)='SHOW S' THEN
  569.         DO
  570.           shosel=''
  571.           selection=';-)'
  572.           LEAVE getloop
  573.         END
  574.       IF UPPER(selection)='SELECT ALL' THEN
  575.         DO
  576.           IF path='' | RIGHT(path,1)=':' | POS(UPPER(path),UPPER(devlist))>0 THEN
  577.             DO
  578.               PRINT
  579.               saytxt=pen3'*** Archiving entire devices at one time is NOT allowed! ***'def||CR
  580.               PRINT saytxt
  581.               PRINT
  582.               ITERATE getloop
  583.             END
  584.           CALL selall(path xrecursive_size)
  585.           shosel=''
  586.           selection=':-)'
  587.           LEAVE getloop
  588.         END
  589.       ELSE IF UPPER(WORD(selection,1))='READ' THEN
  590.         DO
  591.           readflag=1
  592.           selection=STRIP(DELWORD(selection,1,1))
  593.         END
  594.       ELSE IF UPPER(WORD(selection,1))='CD' THEN selection=SUBSTR(selection,4)
  595.       ELSE IF UPPER(WORD(selection,1))='DIR' THEN selection=SUBSTR(selection,5)
  596.     END
  597.   i=FIND('DONE' UPPER(list),UPPER(selection))
  598.   IF i=0 THEN
  599.     DO
  600.       i=FIND('DONE' UPPER(list),UPPER(selection':'))
  601.       IF i=0 THEN
  602.         DO
  603.           IF UPPER(selection)='KINGFISHER' THEN
  604.             DO
  605.               IF EXISTS('rexx:KingFisher.rexx') THEN
  606.                 CALL KingFisher.rexx(name '. .' colorflag maxtime)
  607.               ELSE IF EXISTS(bbspath'rexxDoors/KingFisher.rexx') THEN
  608.                 DO
  609.                   curdir=PRAGMA('D',bbspath'rexxDoors')
  610.                   CALL KingFisher.rexx(name '. .' colorflag maxtime)
  611.                   curdir=PRAGMA('D',curdir)
  612.                 END
  613.               ELSE PRINT 'KingFisher.rexx not found!'
  614.               ITERATE getloop
  615.             END
  616.           ELSE IF UPPER(selection)='Q' THEN selection='DONE'
  617.           ELSE ITERATE getloop
  618.         END
  619.       ELSE selection=selection':'
  620.     END
  621.   IF selection='' & path='' THEN ITERATE getloop
  622.   ELSE IF i>1 THEN selection=WORD(list,i-1)
  623.   IF readflag=1 THEN
  624.     DO
  625.       endtest=UPPER(RIGHT(selection,4))
  626.       IF FIND('.ARC .DMS .LZH .LHA .ZIP .ZOO',endtest)>0 THEN
  627.         DO
  628.           CALL Contents.rexx(path||selection)
  629.           IF EXISTS('RAM:CONTENTS') THEN CALL showtext('RAM: CONTENTS')
  630.         END
  631.       ELSE CALL showtext(path selection)
  632.       readflag=0
  633.       selection=';-)'
  634.     END
  635.   LEAVE getloop
  636. END
  637. RETURN selection
  638.  
  639.  
  640. selall: PROCEDURE EXPOSE selected pen3 def CR
  641. PARSE ARG dir xrecursive_size .
  642. IF FIND(exclude,UPPER(dir))>0 THEN RETURN
  643. saytxt='Sizing'pen3 dir||def||CR
  644. PRINT saytxt
  645. IF RIGHT(dir,1)~='/' THEN dir=dir'/'
  646.  
  647. /* DAS */
  648.  
  649. sizefile='RAM:bbsCDsize'nodex
  650. ADDRESS COMMAND 'c:nl >'sizefile' 'dir' -Z -W -F'
  651. ADDRESS COMMAND 'c:WAIT 5'
  652. okflag=0
  653. fsize=0
  654. DO zloop=1 TO 10
  655.   zz=OPEN(f10,sizefile,'r')
  656.   IF zz=0 THEN
  657.   DO
  658.     PRINT 'Waiting for Sizefile...'
  659.     ADDRESS COMMAND 'c:WAIT 5'
  660.     ITERATE zloop
  661.   END
  662.   ELSE
  663.     DO
  664.       okflag=1
  665.       LEAVE zloop
  666.     END
  667. END
  668. IF okflag~=1 THEN
  669. DO
  670.   PRINT 'Sorry, too many files... SELECT ALL cancelled!'
  671.   ADDRESS COMMAND 'C:WAIT 2'
  672.   RETURN
  673. END
  674. zzsizetot=0
  675. zzfiletot=0
  676. zzdirtot=0
  677. zzpath=''
  678. DO zz2=1
  679.   line = READLN(f10)
  680.   IF EOF(f10) THEN LEAVE zz2
  681.   IF line='' THEN ITERATE
  682.   IF UPPER(WORD(line,2))='FILES' THEN 
  683.   DO
  684.     IF UPPER(WORD(line,1))='NO' THEN iterate zz2
  685.     PRINT RIGHT(zzpath,32)', 'VALUE(WORD(line,1))' file(s), 'VALUE(WORD(line,13))' bytes'
  686.     zzsizetot=zzsizetot+VALUE(WORD(line,13))
  687.     zzfiletot=zzfiletot+VALUE(WORD(line,1))
  688.     zzdirtot=zzdirtot+1
  689.   END
  690. ELSE IF UPPER(WORD(line,1))="DIRECTORY" THEN zzpath=WORD(line,3)
  691. END
  692. CALL CLOSE(f10)
  693. saytxt=pen3'Total:'def' 'zzdirtot''pen3' dir(s), 'def''zzfiletot''pen3' file(s), 'def''zzsizetot''pen3' bytes'||def||CR
  694. PRINT saytxt
  695. IF zzsizetot>xrecursive_size THEN
  696. DO
  697.   saytxt=pen3'*CANCELLED*'def' the maximum bytes allowed per 'pen3'SELECT ALL'def' is: 'pen3''xrecursive_size' bytes!!!'||def||CR
  698.   PRINT saytxt
  699. END
  700. IF zzsizetot~>xrecursive_size THEN selected=selected' 'dir'*'
  701. ADDRESS COMMAND 'C:WAIT 4'
  702. RETURN
  703.  
  704.  
  705. showtext:
  706. PARSE ARG tpath' 'textfile 
  707. test=RIGHT(tpath,1)
  708. IF test~='' & test~=':' & test~='/' THEN tpath=tpath'/'
  709. x=OPEN(f,STRIP(tpath||textfile),'R')
  710. IF x=0 THEN RETURN
  711. test=READCH(f,64)
  712. mask=XRANGE(,'06'x)||XRANGE('0E'x,'1A'x)||XRANGE('1C'x,'1F'x)
  713. IF VERIFY(test,mask,'M')>0 THEN
  714.   DO
  715.     CALL CLOSE(f)
  716.     testloc=VERIFY(test,mask,'M')
  717.     saytxt='*** not an archive or a text file! ***'CR
  718.     PRINT saytxt
  719.     saytxt='Character number' testloc 'is ASCII' C2D(SUBSTR(test,testloc,1))||CR
  720.     PRINT saytxt
  721.     RETURN
  722.   END
  723. CALL SEEK(f,0,'B')
  724. PRINT
  725. saytxt='-' tpath||textfile '-'CR
  726. PRINT saytxt
  727. DO i=1 WHILE ~EOF(f)
  728.   saytxt=COMPRESS(READLN(f),CR||'0C'x)||CR
  729.   PRINT saytxt
  730.   IF i//(linesperpage-1)=0 & nonstop~=1 THEN
  731.     DO
  732.       CALL whodat()
  733. PROMPT 2 NORMAL ' - ['pen3'N'def']on-stop  ['pen3'Q'def']uit  ['pen3'RETURN'def']=Continue - '
  734.       junk=Result
  735.       IF LEFT(UPPER(junk),1)='Q' THEN LEAVE i
  736.       IF LEFT(UPPER(junk),1)='N' THEN nonstop=1
  737.    /*   IF colorflag=1 | ADDRESS()~='BAUD'THEN
  738.         saytxt='1B'x'M'||LEFT('',60)||'1B'x'M'||CR
  739.         PRINT saytxt */
  740.     END
  741. END
  742. CALL CLOSE(f)
  743. IF i//(linesperpage-1)>1 THEN
  744.   DO
  745.     PROMPT 2 NORMAL ' - ['pen3'RETURN'def']=Continue - '
  746.     junk=Result
  747.   END
  748. nonstop=0
  749. RETURN
  750.  
  751.  
  752. whodat:
  753. IF ADDRESS()~='BAUD' THEN RETURN
  754. MSG RIGHT(' ',66-LENGTH(name)) '1B'x'M'||''||''||' 'name' level 'level' '||''
  755. RETURN
  756.  
  757.  
  758. help:
  759. PRINT
  760. PRINT
  761. saytxt=pen3'- HELP -'def
  762. PRINT saytxt
  763. PRINT
  764. saytxt='You can navigate through directory levels using the following commands.'CR
  765. PRINT saytxt
  766. saytxt='Remember that the name must appear in the display before you can select it.'CR
  767. PRINT saytxt
  768. saytxt='Filenames are displayed with their filesizes on the left, and directories'CR
  769. PRINT saytxt
  770. saytxt='will have a' pen3'(dir)'def' on their left.'CR
  771. PRINT saytxt
  772. PRINT
  773. saytxt='To select an item from the displayed list, enter its name as displayed.'CR
  774. PRINT saytxt
  775. saytxt='If the selected item is a' pen3'directory'def', its contents will be displayed.'CR
  776. PRINT saytxt
  777. saytxt='If the selected item is a file, it is added to the ''selected'' list.'CR
  778. PRINT saytxt
  779. saytxt='To remove a selected file from the list, enter its name again.'CR
  780. PRINT saytxt
  781. PRINT
  782. saytxt='To display the parent directory, enter an ''empty'' RETURN'CR
  783. PRINT saytxt
  784. saytxt='To read a textfile or see the contents of an archive, enter' pen3'READ'def 'filename.'CR
  785. PRINT saytxt
  786. saytxt='To select ALL items from the current display, including the contents of all'CR
  787. PRINT saytxt
  788. saytxt='displayed directories and their sub-directories, enter 'pen3'SELECT ALL'def'.'CR
  789. PRINT saytxt
  790. PRINT
  791. IF EXISTS('rexx:KingFisher.rexx') | EXISTS(bbspath'rexxDoors/KingFisher.rexx') THEN
  792.   DO
  793.     saytxt='Enter 'pen3'KINGFISHER'def' to use the online search utility.'CR
  794.     PRINT saytxt
  795.   END
  796. PRINT
  797. saytxt='Enter'pen3 'DONE' def'to return to the BBS (and download any selected files)'CR
  798. PRINT saytxt
  799. PRINT
  800. RETURN
  801.  
  802.  
  803. showtime:
  804. mins=(maxtime-TIME('E'))%60
  805. secs=TRUNC((maxtime-TIME('E'))//60)
  806. IF secs<10 THEN secs='0'secs
  807. RETURN 'Time Remaining: 'mins':'secs
  808.  
  809.  
  810. BREAK_E:
  811. PRINT
  812. saytxt=pen3'*** CONTROL-E BREAK ***'def||CR
  813. PRINT saytxt
  814. i=999999
  815. RETURN ''
  816.  
  817.  
  818. BREAK_C:
  819. PRINT CR
  820. EXIT ''
  821.  
  822. /* bbsExtDL.baud */
  823.